The Best of MacTutor - S…e Code for Volumes 1 to 5/The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin/Source Code/#23 (Aug 87)/color menus source/MenuFun Source

Text File | 1987-06-17 | 10KB | 422 lines

{        MenuFun by Steve Sheets 6/3/87        }

{    Simple Demonstration of Mac // Menu Manager.        }

PROGRAM LMC;

{    Various Constants:    Menu ID Numbers  }
    CONST
        AppleMenuID = 40;
        FileMenuID = 41;
        EditMenuID = 42;
        DisplayMenuID = 43;
        ColorMenuID = 44;
        FontMenuID = 45;
        SizeMenuID = 46;
        StyleMenuID = 47;
        JustMenuID = 48;
        FColorMenuID = 49;
        BColorMenuID = 50;

{    Various Variables:    Menus, Window, Text, Rectangle, Done Flag,    }
{        Colors, Font, Size and Justification Settings.    }
    VAR
        AppleMenu, FileMenu, EditMenu, DisplayMenu, ColorMenu, FontMenu, SizeMenu, StyleMenu, JustMenu, FColorMenu, BColorMenu : MenuHandle;
        MyWindow : windowptr;
        Done : boolean;
        MyStr : str255;
        MyRect : Rect;
        MyFColor, MyBColor, MyFont, MySize, MyJust : integer;
        MyBold, MyItalic, MyUnderline, MyOutline, MyShadow, MyCondense, MyExtend : boolean;
        MyStyle : Style;

{    Redraws the window, by creating an update event.    }
    PROCEDURE ReDraw;
        VAR
            tempPort : Grafptr;
    BEGIN
        GetPort(tempPort);
        SetPort(MyWindow);
        InvalRect(MyRect);
        SetPort(tempPort);
    END;

{    Given the style settings, checks the various Style Menus and creates    }
{        the correct Style variable.    }
    PROCEDURE CheckStyle;
    BEGIN
        MyStyle := [];
        IF MyBold THEN
            BEGIN
                SetItemMark(StyleMenu, 1, CHAR(diamondMark));
                MyStyle := MyStyle + [Bold];
            END
        ELSE
            SetItemMark(StyleMenu, 1, CHAR(noMark));
        IF MyItalic THEN
            BEGIN
                SetItemMark(StyleMenu, 2, CHAR(diamondMark));
                MyStyle := MyStyle + [Italic];
            END
        ELSE
            SetItemMark(StyleMenu, 2, CHAR(noMark));
        IF MyUnderLine THEN
            BEGIN
                SetItemMark(StyleMenu, 3, CHAR(diamondMark));
                MyStyle := MyStyle + [Underline];
            END
        ELSE
            SetItemMark(StyleMenu, 3, CHAR(noMark));
        IF MyOutline THEN
            BEGIN
                SetItemMark(StyleMenu, 4, CHAR(diamondMark));
                MyStyle := MyStyle + [Outline];
            END
        ELSE
            SetItemMark(StyleMenu, 4, CHAR(noMark));
        IF MyShadow THEN
            BEGIN
                SetItemMark(StyleMenu, 5, CHAR(diamondMark));
                MyStyle := MyStyle + [Shadow];
            END
        ELSE
            SetItemMark(StyleMenu, 5, CHAR(noMark));
        IF MyCondense THEN
            BEGIN
                SetItemMark(StyleMenu, 6, CHAR(diamondMark));
                MyStyle := MyStyle + [Condense];
            END
        ELSE
            SetItemMark(StyleMenu, 6, CHAR(noMark));
        IF MyExtend THEN
            BEGIN
                SetItemMark(StyleMenu, 7, CHAR(diamondMark));
                MyStyle := MyStyle + [Extend];
            END
        ELSE
            SetItemMark(StyleMenu, 7, CHAR(noMark));
    END;

{    Given the color number (1-8), returns the correct color constant.    }
    FUNCTION GetColor (C : integer) : longint;
    BEGIN
        CASE C OF
            1 :
                GetColor := BlackColor;
            2 :
                GetColor := WhiteColor;
            3 :
                GetColor := RedColor;
            4 :
                GetColor := GreenColor;
            5 :
                GetColor := BlueColor;
            6 :
                GetColor := CyanColor;
            7 :
                GetColor := MagentaColor;
            8 :
                GetColor := YellowColor;
        END;
    END;

{    Draws the Text in the Rectangle in the correct Colors, Font,        }
{        Size, Style and Justification.    }
    PROCEDURE DoDraw;
        VAR
            tempStr : str255;
            tempInteger : integer;
    BEGIN
        ForeColor(GetColor(MyFColor));
        BackColor(GetColor(MyBColor));
        GetItem(FontMenu, MyFont, tempStr);
        GetFNum(tempStr, tempInteger);
        TextFont(tempInteger);
        CASE MySize OF
            1 :
                TextSize(9);
            2 :
                TextSize(10);
            3 :
                TextSize(12);
            4 :
                TextSize(18);
            5 :
                TextSize(24);
            6 :
                TextSize(32);
        END;
        TextFace(MyStyle);
        TextBox(POINTER(ord4(@MyStr) + 1), LENGTH(MyStr), MyRect, MyJust - 2);
    END;

{    Edit the Text.    }
    PROCEDURE DoEdit;
        VAR
            MyDialog : DialogPtr;
            N : integer;
            MyH : handle;
            MyR : rect;
    BEGIN
        MyDialog := GetNewDialog(130, NIL, POINTER(-1));
        GetDItem(MyDialog, 4, N, MyH, MyR);
        SetIText(MyH, MyStr);

        REPEAT
            ModalDialog(NIL, N);
        UNTIL (N = 1) OR (N = 2);

        IF N = 1 THEN
            BEGIN
                GetIText(MyH, MyStr);
                ReDraw;
            END;

        DisposDialog(MyDialog);
    END;

{    Standard main menu procedure that handles menu selections.  Can show    }
{    About Box, Edit the Text, change the Done Flag (so the program quits),     }
{    handle edit commands (Cut,Copy,Paste,Clear), and change all the Colors,    }
{    Font, Size, Style and Justification of the Text.     }
    PROCEDURE MainMenu (tempResult : LONGINT);
        VAR
            tempInteger : integer;
            tempStr : str255;
    BEGIN
        tempInteger := LoWord(tempResult);
        CASE HiWord(tempResult) OF
            AppleMenuID :
                IF tempInteger = 1 THEN
                    tempInteger := Alert(128, NIL)
                ELSE
                    BEGIN
                        GetItem(appleMenu, tempInteger, tempStr);
                        tempInteger := OpenDeskAcc(tempStr);
                    END;
            FileMenuID :
                IF tempInteger = 1 THEN
                    DoEdit
                ELSE IF tempInteger = 3 THEN
                    Done := (Alert(129, NIL) = 2);
            EditMenuID :
                IF NOT SystemEdit(tempInteger - 1) THEN
                    sysbeep(1);
            FColorMenuID :
                IF (tempInteger <> 0) AND (tempInteger <> MyFColor) THEN
                    BEGIN
                        CheckItem(FColorMenu, MyFColor, false);
                        MyFColor := tempInteger;
                        CheckItem(FColorMenu, MyFColor, true);
                        ReDraw;
                    END;
            BColorMenuID :
                IF (tempInteger <> 0) AND (tempInteger <> MyBColor) THEN
                    BEGIN
                        CheckItem(BColorMenu, MyBColor, false);
                        MyBColor := tempInteger;
                        CheckItem(BColorMenu, MyBColor, true);
                        ReDraw;
                    END;
            FontMenuID :
                IF (tempInteger <> 0) AND (tempInteger <> MyFont) THEN
                    BEGIN
                        CheckItem(FontMenu, MyFont, false);
                        MyFont := tempInteger;
                        CheckItem(FontMenu, MyFont, true);
                        ReDraw;
                    END;
            SizeMenuID :
                IF (tempInteger <> 0) AND (tempInteger <> MySize) THEN
                    BEGIN
                        CheckItem(SizeMenu, MySize, false);
                        MySize := tempInteger;
                        CheckItem(SizeMenu, MySize, true);
                        ReDraw;
                    END;
            StyleMenuID :
                BEGIN
                    CASE tempInteger OF
                        1 :
                            MyBold := NOT MyBold;
                        2 :
                            MyItalic := NOT MyItalic;
                        3 :
                            MyUnderLine := NOT MyUnderLine;
                        4 :
                            MyOutline := NOT MyOutline;
                        5 :
                            MyShadow := NOT MyShadow;
                        6 :
                            MyCondense := NOT MyCondense;
                        7 :
                            MyExtend := NOT MyExtend;
                        OTHERWISE
                    END;
                    CheckStyle;
                    ReDraw;
                END;
            JustMenuID :
                IF (tempInteger <> 0) AND (tempInteger <> MyJust) THEN
                    BEGIN
                        CheckItem(JustMenu, MyJust, false);
                        MyJust := tempInteger;
                        CheckItem(JustMenu, MyJust, true);
                        ReDraw;
                    END;
            OTHERWISE
        END;
        HiliteMenu(0);
    END;

{    Setup for Menus, Window, Done flag, Text, Rectangle, Colors, Font,    }
{        Size, Style and Justification of the Text.}
    PROCEDURE DoSetup;
    BEGIN
        AppleMenu := GetMenu(AppleMenuID);
        AddResMenu(AppleMenu, 'DRVR');

        FileMenu := GetMenu(FileMenuID);

        EditMenu := GetMenu(EditMenuID);

        DisplayMenu := GetMenu(DisplayMenuID);

        ColorMenu := GetMenu(ColorMenuID);

        FontMenu := GetMenu(FontMenuID);
        AddResMenu(FontMenu, 'FONT');
        MyFont := 1;
        CheckItem(FontMenu, MyFont, true);

        SizeMenu := GetMenu(SizeMenuID);
        MySize := 3;
        CheckItem(SizeMenu, MySize, true);

        StyleMenu := GetMenu(StyleMenuID);
        MyBold := false;
        MyItalic := false;
        MyUnderLine := false;
        MyOutline := false;
        MyShadow := false;
        MyCondense := false;
        MyExtend := false;
        CheckStyle;

        JustMenu := GetMenu(JustMenuID);
        MyJust := 3;
        CheckItem(JustMenu, MyJust, true);

        FColorMenu := GetMenu(FColorMenuID);
        MyFColor := 1;
        CheckItem(FColorMenu, MyFColor, true);

        BColorMenu := GetMenu(BColorMenuID);
        MyBColor := 2;
        CheckItem(BColorMenu, MyBColor, true);

        InsertMenu(AppleMenu, 0);
        InsertMenu(FileMenu, 0);
        InsertMenu(EditMenu, 0);
        InsertMenu(DisplayMenu, 0);
        InsertMenu(ColorMenu, -1);
        InsertMenu(FontMenu, -1);
        InsertMenu(SizeMenu, -1);
        InsertMenu(StyleMenu, -1);
        InsertMenu(JustMenu, -1);
        InsertMenu(FColorMenu, -1);
        InsertMenu(BColorMenu, -1);

        DrawMenuBar;

        MyWindow := GetNewWindow(128, NIL, POINTER(-1));

        MyRect := MyWindow^.portRect;

        GetIndString(MyStr, 128, 1);

        InitCursor;

        Done := false;
    END;

{    Standard main program loop that handles all events (ie. mouse down, key    }
{    downs & updates) until the Done flag is set.    }
    PROCEDURE MainLoop;
        VAR
            tempEvent : EventRecord;
            tempWindow : windowptr;
            tempCode : integer;
            tempPort : Grafptr;
            tempRect : rect;
            tempLong : longint;
    BEGIN
        REPEAT
            SystemTask;
            IF GetNextEvent(everyEvent, tempEvent) THEN
                BEGIN
                    CASE tempEvent.what OF
                        mouseDown :
                            BEGIN
                                tempCode := FindWindow(tempEvent.where, tempWindow);
                                CASE tempCode OF
                                    inDrag, inContent :
                                        BEGIN
                                            IF tempWindow <> FrontWindow THEN
                                                SelectWindow(tempWindow)
                                            ELSE
                                                BEGIN
                                                    IF MyWindow = tempWindow THEN
                                                        BEGIN
                                                            SetRect(tempRect, -25000, -25000, 25000, 25000);
                                                            DragWindow(MyWindow, tempEvent.where, tempRect);
                                                        END;
                                                END;
                                        END;
                                    inGrow :
                                        BEGIN
                                            IF tempWindow <> FrontWindow THEN
                                                SelectWindow(tempWindow)
                                            ELSE
                                                BEGIN
                                                    IF MyWindow = tempWindow THEN
                                                        BEGIN
                                                            SetRect(tempRect, -25000, -25000, 25000, 25000);
                                                            tempLong := GrowWindow(MyWindow, tempEvent.where, tempRect);
                                                            SizeWindow(MyWindow, LoWord(tempLong), HiWord(tempLong), false);
                                                            MyRect := MyWindow^.portRect;
                                                            ReDraw;
                                                        END;
                                                END;
                                        END;
                                    inMenuBar :
                                        MainMenu(MenuSelect(tempEvent.where));
                                    inSysWindow :
                                        SystemClick(tempEvent, tempWindow);
                                    OTHERWISE
                                END; { of tempCode case }
                            END; { of mouseDown }
                        keydown, autoKey :
                            IF BitAnd(tempEvent.modifiers, cmdKey) <> 0 THEN
                                MainMenu(MenuKey(CHR(tempEvent.message MOD 256)));
                        updateEvt :
                            IF MyWindow = WindowPtr(tempEvent.message) THEN
                                BEGIN
                                    GetPort(tempPort);
                                    SetPort(MyWindow);
                                    BeginUpdate(MyWindow);
                                    DoDraw;
                                    EndUpdate(MyWindow);
                                    SetPort(tempPort);
                                END;
                        OTHERWISE
                    END;
                END;
        UNTIL Done;
    END;

{    ***PROGRAM***    }
BEGIN
    DoSetup;
    MainLoop;
END.